home *** CD-ROM | disk | FTP | other *** search
/ The 640 MEG Shareware Studio 2 / The 640 Meg Shareware Studio CD-ROM Volume II (Data Express)(1993).ISO / pascal / inline22.zip / UNINLINE.PAS < prev    next >
Pascal/Delphi Source File  |  1989-03-04  |  23KB  |  838 lines
  1. {$R-}    {Range checking off}
  2. {$B-}    {Boolean short circuiting off}
  3. {$S-}    {Stack checking off}
  4. {$I+}    {I/O checking on}
  5. {$N-}    {No numeric coprocessor}
  6. {$V-}    {Relaxed String Checking}
  7. {$M 65500,16384,655360} {Turbo 3 default stack and heap}
  8.  
  9.                           {UNINLINE7}
  10. (*********  Source code Copyright 1986, by L. David Baldwin   *********)
  11. {
  12. Version 1.1.  Convert to Turbo 4.
  13. }
  14. program Inline_disasm;
  15.  
  16. Uses
  17.   Crt;
  18.  
  19. Const
  20.   Tab = 9;
  21.   Signon1 : String[35] = ^M^J'Inline Disassembler, Vers 1.1'^M^J;
  22.   Signon2 : String[40] = '(C) Copyright 1986 by L. David Baldwin'^M^J;
  23.  
  24.   Ulen=80;
  25.   Symbolleng=28;
  26.   MaxByte=Maxint;
  27.   Tokenleng=7;
  28.   MaxLabels=300;
  29.   PhraseOk=True;
  30.   FirstTab=7;
  31.   SecondTab=15;
  32. Type
  33.   Byteptr=^Byte;
  34.   Ptrrec=Record R,S :Word; end;
  35.   String8=String[8];
  36.   String127=String[127];
  37.   String2=Array[1..2] of Char;
  38.   Filestring=String[64];
  39.   Regstrtype=Array[0..15] of Array[1..2] of Char;
  40.   Segregtype=Array[0..3] of Array[1..2] of Char;
  41.  
  42. {Packet holds a displacement which may be either in phrase form (symbolic
  43.   expression) or numeric form.  It may be of byte or word size}
  44.   Packet =Record
  45.            Dispsize :(Bytesize,Wordsize);
  46.            case Phrase : Boolean of  {either a numeric or symbollic phrase}
  47.               True   :(S :String[Symbolleng]);
  48.               False  :(Value : Integer);
  49.            end;
  50.   Line = Record  {Disassembled instruction is built up in a 'line'}
  51.           case Boolean of
  52.             True:  (S:String[Ulen]);
  53.             False :(Len : Byte; PCsave : Integer);
  54.            end;
  55. Var
  56.   Ustring : Line;
  57.   Chi,PC,PCstart,PCfinish : Integer;
  58.   NValue :Word;
  59.   Token : String[Tokenleng];
  60.   Pair : String2;
  61.   LCh : Char Absolute Pair;
  62.   UCh     :Char;
  63.   St      :String127;
  64.   Symname:String[Symbolleng];
  65.   EofInf,BytePending,Firsttime,Wd,ToReg,PrefixFl,Wait_Found : Boolean;
  66.   Reg,Mode,Rm : Word;
  67.   Opcode,PendingByte :Byte;
  68.   UsIndex,TIndex,LabelIndx,ErrCount : Integer;
  69.   TextArray : Array[0..MaxByte] of Char;
  70.   Inf,Outf : Text;
  71.   Labels : Array[0..MaxLabels] of Record          {Holds info on needed labels}
  72.              PCvalue : Integer; Found : Boolean;
  73.              end;
  74.  
  75. Const Opcodes : Array[0..$FF] of Byte = (
  76.    5,5,5,5,5,5,73,71,69,69,69,69,69,69,73,20,
  77.    4,4,4,4,4,4,73,71,86,86,86,86,86,86,73,71,
  78.    6,6,6,6,6,6,24,18,97,97,97,97,97,97,16,19,
  79.    102,102,102,102,102,102,91,0,13,13,13,13,13,13,23,3,
  80.    29,29,29,29,29,29,29,29,21,21,21,21,21,21,21,21,
  81.    73,73,73,73,73,73,73,73,71,71,71,71,71,71,71,71,
  82.    20,20,20,20,20,20,20,20,20,20,20,20,20,20,20,20,
  83.    49,46,34,41,37,43,35,42,51,48,50,47,38,44,39,45,
  84.    20,20,20,20,98,98,100,100,62,62,62,62,62,54,62,71,
  85.    67,100,100,100,100,100,100,100,8,17,7,99,74,72,84,52,
  86.    62,62,62,62,63,64,14,15,98,98,95,96,57,58,87,88,
  87.    62,62,62,62,62,62,62,62,62,62,62,62,62,62,62,62,
  88.    20,20,80,80,55,53,62,62,20,20,81,81,32,30,31,33,
  89.    20,20,20,20,2,1,20,101,20,20,20,20,20,20,20,20,
  90.    61,60,59,36,28,28,70,70,7,40,40,40,28,28,70,70,
  91.    56,20,79,78,25,12,20,20,9,92,11,94,10,93,20,20);
  92.  
  93. Const Grp1_2names : Array[0..15] of Byte =
  94.                (98,75,68,66,65,27,22,26,29,21,7,7,40,40,73,75);
  95.  
  96. Const Shiftnames : Array[0..7] of Byte =(82,83,76,77,89,90,75,85);
  97.  
  98. Const Immednames : Array[0..7] of Byte = (5,69,4,86,6,97,102,13);
  99.  
  100. Const Instrnames : Array[0..102] of String[6] = (
  101. 'AAA',  'AAD',   'AAM',  'AAS',  'ADC',  'ADD',  'AND',  'CALL', 'CBW',  'CLC',
  102. 'CLD',  'CLI',   'CMC',  'CMP',  'CMPSB','CMPSW','CS:',  'CWD',  'DAA',  'DAS',
  103. 'DB',   'DEC',   'DIV',  'DS:',  'ES:',  'HLT',  'IDIV', 'IMUL', 'IN',   'INC',
  104. 'INT',  'INTO',  'INT 3','IRET', 'JB',   'JBE',  'JCXZ', 'JZ',   'JL',   'JLE',
  105. 'JMP',  'JNB',   'JA',   'JNZ',  'JGE',  'JG',   'JNO',  'JPO',  'JNS',  'JO',
  106. 'JPE',  'JS',    'LAHF', 'LDS',  'LEA',  'LES',  'LOCK', 'LODSB','LODSW','LOOP',
  107. 'LOOPE','LOOPNE','MOV',  'MOVSB','MOVSW','MUL',  'NEG',  'NOP',  'NOT',  'OR',
  108. 'OUT',  'POP',   'POPF', 'PUSH', 'PUSHF','???',  'RCL',  'RCR',  'REPE', 'REPNE',
  109. 'RET',  'RETF',  'ROL',  'ROR',  'SAHF' ,'SAR',  'SBB',  'SCASB','SCASW','SHL',
  110. 'SHR',  'SS:',   'STC',  'STD',  'STI',  'STOSB','STOSW','SUB',  'TEST', 'WAIT',
  111. 'XCHG', 'XLAT',  'XOR');
  112.  
  113.  
  114. Const   RegStr : Regstrtype = (
  115.                 'AX','CX','DX','BX','SP','BP','SI','DI',
  116.                 'AL','CL','DL','BL','AH','CH','DH','BH');
  117.         SegRegStr : Segregtype = ('ES','CS','SS','DS');
  118.  
  119.  
  120. {-------------OutUstring}
  121. PROCEDURE OutUstring;
  122. Var Tmp : Integer;
  123. begin
  124. (* WriteLn(Ustring.S);      *)
  125. if TIndex < MaxByte-Ulen then
  126.   begin
  127.   Tmp:=Ustring.Len+1;
  128.   Move(Ustring, TextArray[TIndex], Tmp);
  129.   TIndex:=TIndex+Tmp;
  130.   end
  131. else
  132.   begin
  133.   WriteLn('Output Array Overflow');
  134.   Halt(1);
  135.   end;
  136. end;
  137.  
  138. {-------------Error}
  139. PROCEDURE Error(II :Integer; S :String127);
  140. Var X,Y : Integer;
  141.   NewS : String127;
  142. begin
  143. GotoXY(1,WhereY);
  144. WriteLn(St);
  145. Y:=WhereY;
  146. X:=II-3; if X<1 then X:=1;
  147. GotoXY(X, Y);
  148. Write('^');
  149. if S[0]>#0 then  NewS:='Error, '+S else NewS:='Error';
  150. if X+Ord(NewS[0])>80 then X:=X-Ord(NewS[0]) else X:=X+1;
  151. GotoXY(X,Y);  WriteLn(NewS);
  152. ErrCount:=Succ(ErrCount);
  153. if ErrCount>6 then
  154.   begin
  155.   WriteLn('Excessive Number of Errors');
  156.   Halt(1);
  157.   end;
  158. end;
  159.  
  160.  
  161. PROCEDURE ByteErr; Forward;
  162. PROCEDURE NumbyteErr; Forward;
  163. {$I unpars.inc}
  164.  
  165. {-------------InsrtChr}
  166. PROCEDURE InsrtChr(C :Char);
  167. begin
  168. Ustring.S[UsIndex]:=C;
  169. if Ustring.Len<UsIndex then Ustring.Len:=UsIndex;
  170. UsIndex:=UsIndex+1;
  171. end;
  172.  
  173. {-------------Comma}
  174. PROCEDURE Comma;
  175. begin  InsrtChr(','); end;
  176.  
  177. {-------------InsrtSt}
  178. PROCEDURE InsrtSt(S :String127);
  179. Var     K       :Integer;
  180. begin
  181. for K:=1 to Ord(S[0]) do
  182.    begin
  183.    InsrtChr(S[K]);
  184.    end;
  185. end;
  186.  
  187. Type String4=String[4];
  188. {-------------Hex2}
  189. FUNCTION Hex2(B :Byte): String4;
  190. Const HexDigs :Array[0..15] of Char = '0123456789ABCDEF';
  191. Var Bz :Byte;
  192. begin
  193. Bz:=B and $F;  B:=B Shr 4;
  194. Hex2:=HexDigs[B]+HexDigs[Bz];
  195. end;
  196.  
  197. {-------------Hex4}
  198. FUNCTION Hex4(W :Integer): String4;
  199. begin Hex4:=Hex2(Hi(W))+Hex2(Lo(W)); end;
  200.  
  201. {-------------Insrthx2}
  202. PROCEDURE Insrthx2(B :Byte);
  203. begin
  204. InsrtChr('$');
  205. InsrtSt(Hex2(B));
  206. end;
  207.  
  208. {-------------Insrthx4}
  209. PROCEDURE Insrthx4(W :Word);
  210. begin
  211. InsrtChr('$');
  212. InsrtSt(Hex4(W));
  213. end;
  214.  
  215. {-------------InsrtDisp}
  216. PROCEDURE InsrtDisp(Disp : Packet);
  217. begin
  218. with Disp do
  219.   if not Phrase then
  220.     begin
  221.     if (Dispsize=Bytesize)  then
  222.        begin
  223.        if Value and $80 <>0 then
  224.           begin
  225.           InsrtChr('-');  {turn into negative number}
  226.           Value:=-(Value or $FF00);
  227.           end
  228.        else InsrtChr('+');
  229.        Insrthx2(Lo(Value));
  230.        end
  231.     else
  232.        Insrthx4(Value);
  233.     end
  234.   else InsrtSt(S);
  235. end;
  236.  
  237. {-------------FormLabel}
  238. FUNCTION FormLabel(N : Integer): String8;
  239. Var S : String8;
  240. begin
  241. Str(N,S);
  242. FormLabel:='X'+S;
  243. end;
  244.  
  245. {-------------OutLabel}
  246. PROCEDURE OutLabel(N : Integer);
  247.  
  248.   PROCEDURE AddLabel(N : Integer);
  249.   Var I : Integer; Fnd : Boolean;
  250.   begin
  251.   Fnd:=False;   {only add label if it isn't already there}
  252.   I:=0;
  253.   while (I<LabelIndx) and not Fnd do
  254.     begin Fnd:=Labels[I].PCvalue=N;  I:=Succ(I); end;
  255.   if not Fnd then
  256.     if LabelIndx<=MaxLabels then
  257.       with Labels[LabelIndx] do
  258.         begin
  259.         PCvalue:=N;
  260.         Found:=False;   {will try to find it later}
  261.         LabelIndx:=Succ(LabelIndx);
  262.         end;
  263.   end;
  264. begin
  265. AddLabel(N);
  266. InsrtSt(FormLabel(N));
  267. end;
  268.  
  269. {-------------ByteErr}
  270. PROCEDURE ByteErr;
  271. begin
  272. Error(Chi,'Byte Exp');
  273. Next;  {pass it by}
  274. PC:=Succ(PC);
  275. end;
  276.  
  277. {-------------NumbyteErr}
  278. PROCEDURE NumbyteErr;
  279. begin
  280. Error(Chi,'Numerical Byte Exp');
  281. Next;  {pass it by}
  282. PC:=Succ(PC);
  283. end;
  284.  
  285. {-------------ShortJump}
  286. PROCEDURE ShortJump;
  287. {the short jump instructions}
  288. Var Pk : Packet;
  289.     Vl : Word;
  290. begin
  291. if not GetByte(Pk,PhraseOk) then ByteErr;
  292. if (Opcode=$EB) then InsrtSt('SHORT ');
  293. with Pk do
  294.   if not Phrase then
  295.     begin
  296.     Vl:=Value;
  297.     if (Vl and $80 <>0) then Vl:=Vl or $FF00;  {sign extend}
  298.     Vl:=Vl+PC;
  299.     OutLabel(Vl);
  300.     end
  301.   else InsrtDisp(Pk);
  302. end;
  303.  
  304. {-------------IntraSeg}
  305. PROCEDURE IntraSeg;
  306. {the intrasegment direct jumps and calls}
  307. Var Pk : Packet;
  308. begin
  309. GetWord(Pk);
  310. InsrtSt('NEAR ');
  311. if not Pk.Phrase then OutLabel(Pk.Value+PC)
  312.   else InsrtDisp(Pk);
  313. end;
  314.  
  315. {-------------InterSeg}
  316. PROCEDURE InterSeg;
  317. {the intersegment direct jumps and calls}
  318. Var Segm,Ofst : Packet;
  319. begin
  320. GetWord(Ofst);  GetWord(Segm);
  321. InsrtSt('FAR ');
  322. InsrtDisp(Segm); InsrtSt(':'); InsrtDisp(Ofst);
  323. end;
  324.  
  325. {-------------MovImToReg}
  326. PROCEDURE MovImToReg;
  327. {the move immediate to a reg such as mov bl,12 }
  328. Var Disp : Packet;
  329. begin
  330. Reg:=(Opcode and $F) Xor 8;
  331. InsrtSt(RegStr[Reg]);  Comma;
  332. if (Opcode and 8)<>0 {word} then
  333.     GetWord(Disp)
  334. else
  335.     if not GetByte(Disp,PhraseOk) then ByteErr;
  336. InsrtDisp(Disp);
  337. end;
  338.  
  339. {-------------DoMem}
  340. PROCEDURE DoMem(Disp : Packet);
  341. Type  Rptype=Array[0..7] of String[5];
  342. Const Regphrase : Rptype = (
  343.          'BX+SI','BX+DI','BP+SI','BP+DI','SI','DI','BP','BX');
  344.  
  345. begin
  346. if Mode=3 then
  347.    begin        {its a reg}
  348.    if not Wd then Rm:=Rm+8;
  349.    InsrtSt(RegStr[Rm]);
  350.    end
  351. else
  352.    begin        {its a memory}
  353.    InsrtChr('[');
  354.    if (Rm=6) and (Mode=0) then
  355.       InsrtDisp(Disp)
  356.    else
  357.       begin     {need a register phrase}
  358.       InsrtSt(Regphrase[Rm]);
  359.       if Mode<>0 then
  360.          begin
  361.          if (Disp.Dispsize=Wordsize) or Disp.Phrase then InsrtChr('+');
  362.          InsrtDisp(Disp);
  363.          end;
  364.       end;
  365.    InsrtChr(']');
  366.    end;
  367. end;
  368.  
  369. {-------------DoReg}
  370. PROCEDURE DoReg;
  371. begin
  372. if not Wd then Reg:=Reg+8;
  373. InsrtSt(RegStr[Reg]);
  374. end;
  375.  
  376. {-------------ReadModeByte}
  377. PROCEDURE ReadModeByte(Var Disp : Packet);
  378. {read the mode byte and sort out the various parts.  read the
  379.  displacement byte or word if req'D}
  380. Var Modebyte : Byte;
  381.     Pk : Packet;
  382. begin
  383. if not GetByte(Pk, not PhraseOk) then NumbyteErr;
  384. Modebyte:=Lo(Pk.Value);
  385. Rm:=Modebyte and 7;
  386. Mode:=(Modebyte and $C0) div 64;
  387. Reg:=(Modebyte and $38) div 8;
  388. if (Mode=0) and (Rm=6) or (Mode=2) then
  389.    GetWord(Disp)        {get address or 16 bit disp}
  390. else if Mode=1 then     {its a 8 bit displ}
  391.    if not GetByte(Disp, PhraseOk) then ByteErr;
  392. end;
  393.  
  394. {-------------MemSeg}
  395. PROCEDURE MemSeg;
  396. {move seg reg to/from mem/reg}
  397. Var Disp : Packet;
  398. begin
  399. ToReg:=(Opcode and 2)<>0;
  400. Wd:=True;
  401. ReadModeByte(Disp);
  402. Reg:=Reg and 3; {0..3}
  403. if ToReg then
  404.    begin InsrtSt(SegRegStr[Reg]);  Comma; DoMem(Disp);  end
  405. else
  406.    begin DoMem(Disp); Comma; InsrtSt(SegRegStr[Reg]); end;
  407. end;
  408.  
  409. {-------------ImedToAc}
  410. PROCEDURE ImedToAc;     {do the immediates to ac}
  411. Var Disp : Packet;
  412. begin
  413. Wd:=(Opcode and 1)<>0;
  414. Reg:=0;         {ax or al}
  415. if Wd then
  416.    GetWord(Disp)
  417. else
  418.    if not GetByte(Disp, PhraseOk) then ByteErr;
  419. DoReg; Comma;
  420. if Wd or Disp.Phrase then InsrtDisp(Disp)
  421.   else Insrthx2(Lo(Disp.Value));  {no sign}
  422. end;
  423.  
  424. {-------------Immed}
  425. PROCEDURE Immed;        {add reg/mem,12   xor reg/mem,1234}
  426. Var     Signext :Boolean;
  427.         D1,D2 : Packet;
  428. begin
  429. Wd:=(Opcode and 1)<>0;
  430. Signext:=((Opcode and 2)<>0) and (Opcode<=$83);{mov does not have sign ext}
  431. ReadModeByte(D1);
  432. if Opcode<=$83 then     {mov has name output already}
  433.    InsrtSt(Instrnames[Immednames[Reg]]);
  434. UsIndex:=SecondTab;
  435. if Wd and not Signext then
  436.   GetWord(D2)
  437. else
  438.   if not GetByte(D2, PhraseOk) then ByteErr;
  439. if Mode<>3 then
  440.    begin
  441.    if Wd then InsrtSt('WORD PTR ')
  442.    else InsrtSt('BYTE PTR ');
  443.    end;
  444. DoMem(D1); Comma;
  445. InsrtDisp(D2);
  446. end;
  447.  
  448. {$I flpt.inc}
  449.  
  450. {-------------DoShift}
  451. PROCEDURE DoShift;      {do the shift and rotate instr}
  452. Var Pk : Packet;
  453. begin
  454. Wd:=(Opcode and 1)<>0;
  455. ReadModeByte(Pk);
  456. InsrtSt(Instrnames[Shiftnames[Reg]]);
  457. UsIndex:=SecondTab;
  458. if Mode<>3 then
  459.    begin
  460.    if Wd then InsrtSt('WORD PTR ')
  461.    else InsrtSt('BYTE PTR ');
  462.    end;
  463. DoMem(Pk); Comma;
  464. if (Opcode and 2)<>0 then
  465.    InsrtSt('CL') else InsrtSt('1');
  466. end;
  467.  
  468. {-------------DoGroup1_2}
  469. PROCEDURE DoGroup1_2;   {f6,f7,fe,ff}
  470. Var Pk : Packet;
  471. begin
  472. Wd:=(Opcode and 1)<>0;
  473. ReadModeByte(Pk);
  474. if (Opcode and 8)<>0 then Reg:=Reg+8;   {reg is ptr to name in this case}
  475. if (Opcode=$FE) then if (Reg>=$A) then
  476.    Reg:=$F;     {no call, jmp, push of bytes}
  477. InsrtSt(Instrnames[Grp1_2names[Reg]]);
  478. UsIndex:=SecondTab;
  479. if (Reg=$A) or (Reg=$C) then InsrtSt('NEAR ')
  480. else if (Reg=$B) or (Reg=$D) then InsrtSt('FAR ')
  481. else if (Mode<>3) then if (Reg<>$E) {push}  then
  482.    begin
  483.    if Wd then InsrtSt('WORD PTR ')
  484.    else InsrtSt('BYTE PTR ');
  485.    end;
  486. DoMem(Pk);
  487. if Reg=0 then
  488.    begin        {test}
  489.    Comma;
  490.    if Wd then begin GetWord(Pk); InsrtDisp(Pk); end
  491.    else
  492.      begin
  493.      if not GetByte(Pk, PhraseOk) then ByteErr;
  494.      if Pk.Phrase then InsrtDisp(Pk)
  495.      else Insrthx2(Lo(Pk.Value));       {no sign}
  496.      end;
  497.    end;
  498. end;
  499.  
  500. {-------------MemToReg}
  501. PROCEDURE MemToReg;
  502. {lds,les,lea}
  503. Var Pk : Packet;
  504. begin
  505. Wd:=True; ToReg:=True;
  506. ReadModeByte(Pk);
  507. DoReg; Comma;
  508. DoMem(Pk);
  509. end;
  510.  
  511. {-------------MemAccum}
  512. PROCEDURE MemAccum;
  513. {handle mov ac,[1234] , cmp ac,[5678] etc}
  514. Var Disp : Packet;
  515. begin
  516. Wd:=(Opcode and 1)<>0;
  517. ToReg:=(Opcode and 2)=0;        {note the difference in sense}
  518. Reg:=0; {will be ax or al}
  519. GetWord(Disp);
  520. Rm:=6; Mode:=0;         {for displacement only}
  521. if ToReg then
  522.    begin DoReg; Comma; DoMem(Disp); end
  523. else
  524.    begin DoMem(Disp); Comma; DoReg; end;
  525. end;
  526.  
  527. {-------------MregMreg}
  528. PROCEDURE MregMreg;
  529. {do the mem/reg, mem/reg instructions, such as mov bx,[bp+1234]
  530.  or add [bx],dx }
  531. Var Pk : Packet;
  532. begin
  533. Wd:=(Opcode and 1)<>0;
  534. ToReg:=(Opcode and 2)<>0;
  535. ReadModeByte(Pk);
  536. if ToReg then
  537.    begin DoReg; Comma; DoMem(Pk); end
  538. else
  539.    begin DoMem(Pk); Comma; DoReg; end;
  540. end;
  541.  
  542. {-------------Rep_lock}
  543. PROCEDURE Rep_lock;     {do lock, repe, repne,wait, and seg overrides}
  544. begin
  545. PrefixFl:=True;
  546. OutUstring;
  547. end;
  548.  
  549. {-------------UnAssem1}
  550. PROCEDURE UnAssem1;
  551. {unassemble one line of code (or two if preceeded by a seg instruction)
  552.  output the unassembled line in ustring.}
  553. Label 10;
  554. Const
  555.   Dolater : set of Byte = [$9B,$F6,$F7,$FE,$FF,$D0..$D3,$D8..$DF,$80..$83];
  556. Var
  557.   Pk : Packet;
  558.   Err : Boolean;
  559.     PROCEDURE InsByte;
  560.     Var Pk1 : Packet;
  561.     begin
  562.     if not GetByte(Pk1, PhraseOk) then ByteErr;
  563.     if Pk1.Phrase then InsrtDisp(Pk1) else Insrthx2(Lo(Pk1.Value));
  564.     end;
  565. begin
  566. Wait_Found:=False;
  567. repeat
  568.   PrefixFl:=False;      {set true later if a segm overide instr found}
  569.   Ustring.Len:=0;
  570.   FillChar(Ustring.S[1], Ulen, ' ');     {clear ustring}
  571.   Ustring.PCsave:=PC;
  572.   repeat
  573.     Err:=not GetByte(Pk, not PhraseOk);
  574.     if Err then begin NumbyteErr; Next; end;
  575.     Opcode:=Pk.Value;
  576.   until not Err;
  577.   UsIndex:=FirstTab;
  578.   if not (Opcode in Dolater) then
  579.     begin       {most items have opcode name output now}
  580.     InsrtSt(Instrnames[Opcodes[Opcode]]);
  581.     UsIndex:=SecondTab;
  582.     end;
  583.   case Opcode of
  584.         $27,$2F,$37,$3F,
  585.         $90,$98,$99,$9C..$9F,$AA..$AF,$A4..$A7,
  586.         $C3,$CB,$CC,$CE,$CF,$D7,$F4,$F5,
  587.         $F8..$FD        :;      {opcode only}
  588.  
  589.         $26,$36,$2E,$3E,                {seg overide inst}
  590.         $F0,$F2,$F3     :Rep_lock;      {lock, repe, repne}
  591.  
  592.         $40..$5F,
  593.         $91..$97        :begin
  594.                          InsrtSt(RegStr[Opcode and 7]); {push,pop,xchg
  595.                                                              inc,dec}
  596.                          if Opcode>=$91 then
  597.                            InsrtSt(',AX');      {xchg}
  598.                          end;
  599.  
  600.         0..3,8..$B,$10..$13,$18..$1B,
  601.         $20..$23,$28..$2B,$30..$33,$38..$3B,$84..$87,
  602.         $88..$8B        :MregMreg;
  603.   
  604.         $B0..$BF        :MovImToReg;    {mov cx,1234 etc.}
  605.         
  606.         $70..$7F,$E0..$E3,
  607.         $EB             :ShortJump;
  608.  
  609.         $E8,$E9         :IntraSeg;
  610.         
  611.         $EA,$9A         :InterSeg;
  612.         
  613.         6,7,$E,$16,$17,$1E,$1F
  614.                         :begin          {seg, push-pop seg}
  615.                          Reg:=(Opcode div 8) and 3;
  616.                          InsrtSt(SegRegStr[Reg]);
  617.                          end;
  618.         $4,$5,$C,$D,$14,$15,$1C,$1D,$24,$25,$2C,$2D,$34,$35,$3C,$3D,
  619.         $A8,$A9         :ImedToAc;
  620.  
  621.         $A0..$A3        :MemAccum;      {mov ac,[1234] }
  622.  
  623.         $C4,$C5,$8D     :MemToReg;      {les,lds,lea}
  624.         
  625.         $CD             :InsByte;       {int n}
  626.         
  627.         $EE,$EF         :begin  {out dx,ac}
  628.                          Wd:=True; Reg:=2;
  629.                          DoReg;
  630. 10:                      Comma;
  631.                          Wd:=(Opcode and 1)<>0;
  632.                          Reg:=0;        {ax or al}
  633.                          DoReg;
  634.                          end;
  635.  
  636.         $E4,$E5,$EC,$ED :begin  {in ac, dx or port}
  637.                          Wd:=(Opcode and 1)<>0;
  638.                          Reg:=0;
  639.                          DoReg;
  640.                          Comma;
  641.                          if (Opcode>=$EC) then
  642.                             begin Wd:=True; Reg:=2; DoReg; end
  643.                          else InsByte;
  644.                          end;
  645.  
  646.         $E6,$E7         :begin  {out port,ac}
  647.                          InsByte;
  648.                          GOTO 10;
  649.                          end;
  650.  
  651.         $8C,$8E         :MemSeg;        {segment, reg instr}
  652.  
  653.         $F6,$F7,$FE,$FF :DoGroup1_2;
  654.  
  655.         $D0..$D3        :DoShift;
  656.  
  657.         $80..$83,$C6,$C7:Immed;
  658.  
  659.         $8F             :begin
  660.                          Wd:=True;      {pop reg/mem}
  661.                          ReadModeByte(Pk);
  662.                          DoMem(Pk);
  663.                          end;
  664.         $C2,$CA         :begin GetWord(Pk);InsrtDisp(Pk); end;     {ret n}
  665.         $D4,$D5         :begin                           {aam,aad}
  666.                          if not GetByte(Pk,PhraseOk) then ByteErr;
  667.                          if not Pk.Phrase then
  668.                            if Pk.Value<>$A then Insrthx2(Lo(Pk.Value));
  669.                          end;
  670.  
  671.         $9B             :{WAIT - look to see if it preceeds a Fl Point instr}
  672.                          if((Sy=Wordsy) or (Sy=Bytesy)) and (Lo(NValue)>=$D8)
  673.                             and (Lo(NValue)<=$DF) then
  674.                               begin Wait_Found:=True; PrefixFl:=True; end
  675.                               else InsrtSt(Instrnames[Opcodes[$9B]]);
  676.                                         {plain wait}
  677.         $DA,$DE         :Da_de;
  678.         $D8,$DC         :D8_dc;
  679.         $D9             :D9;
  680.         $DB             :Db;
  681.         $DD             :Dd;
  682.         $DF             :Df;
  683.  
  684.      else  Insrthx2(Opcode);       {for db (databyte)}
  685.      end;       {case}
  686. until PrefixFl=False;
  687. OutUstring;
  688. end;
  689.  
  690. {-------------Chk_IOerror}
  691. FUNCTION Chk_IOerror(S : Filestring): Integer;
  692. Var IOerr : Integer;
  693. begin
  694. IOerr := IOResult;
  695. if (IOerr = 2) or (IOerr = 3) then WriteLn('Can''t find ', S)
  696. else if IOerr <> 0 then WriteLn('I/O Error ', Hex4(IOerr));
  697. Chk_IOerror := IOerr;
  698. end;
  699.  
  700. {-------------PromptForInput}
  701. PROCEDURE PromptForInput;
  702. Var
  703.   InName,Name : Filestring;
  704.   Err : Integer;
  705. begin
  706. {$I-}
  707. repeat
  708.   Write('Inline Object Filename [.INL]: '); ReadLn(InName);
  709.   if InName='' then Halt;
  710.   DefaultExtension('INL', InName, Name);
  711.   Assign(Inf, InName); Reset(Inf);
  712.   Err:=Chk_IOerror(InName);
  713.   if Err>1 then Halt(1);
  714. until Err=0;
  715.  
  716. Write('Assembly Language Source Filename [', Name, '.ASM]: '); ReadLn(InName);
  717. if InName='' then InName:=Name;   {Use the same name}
  718. DefaultExtension('ASM',InName,Name);
  719. Assign(Outf, InName);
  720. Rewrite(Outf);
  721. if Chk_IOerror(InName)<>0 then Halt(1);
  722. {$I+}
  723. end;
  724.  
  725. {-------------CommandInput}
  726. PROCEDURE CommandInput;
  727. Var
  728.   InName,Name : Filestring;
  729.  
  730.   PROCEDURE DoHelp;
  731.   begin
  732.   Halt;
  733.   end;
  734.  
  735. begin
  736. InName:=ParamStr(1);
  737. if Pos('?', InName)<>0 then DoHelp;
  738. DefaultExtension('INL', InName, Name);
  739. {$I-}
  740. Assign(Inf, InName);
  741. Reset(Inf);
  742. if Chk_IOerror(InName)<>0 then Halt(1);
  743. if ParamCount>=2 then InName:=ParamStr(2)
  744.   else InName:=Name;             {Use the old name}
  745. DefaultExtension('ASM',InName,Name);
  746. Assign(Outf, InName);
  747. Rewrite(Outf);
  748. if Chk_IOerror(InName)<>0 then Halt(1);
  749. {$I+}
  750. end;
  751.  
  752. {-------------ReportLabelErrors}
  753. PROCEDURE ReportLabelErrors;
  754. Var I : Integer;
  755. begin
  756. if LabelIndx>MaxLabels then
  757.   WriteLn('Number of labels exceeds array capacity');
  758. for I:=0 to LabelIndx-1 do
  759.   with Labels[I] do
  760.     if not Found then
  761.       if (PCvalue<PCstart) or (PCvalue>PCfinish) then
  762.         WriteLn('Label ',FormLabel(PCvalue),' is out of Inline code range')
  763.       else
  764.         WriteLn('Label ',FormLabel(PCvalue),' cannot be found');
  765. end;
  766.  
  767. {-------------WriteToFile}
  768. PROCEDURE WriteToFile;
  769. Var
  770.   P : ^Line;
  771.   Px : Ptrrec Absolute P;
  772.   I,Tmp : Integer;
  773.   LB : String8;
  774.  
  775.   FUNCTION FindLabel(N : Integer): Boolean;
  776.   Var I : Integer;  Fnd : Boolean;
  777.   begin
  778.   Fnd:=False; I:=0;
  779.   while (I<LabelIndx) and not Fnd do
  780.     begin Fnd:=Labels[I].PCvalue=N;  I:=Succ(I); end;
  781.   if Fnd then Labels[I-1].Found:=True;
  782.   FindLabel:=Fnd;
  783.   end;
  784. begin
  785. P:=Addr(TextArray);
  786. I:=0;
  787. while I < TIndex do  {tindex now is index to last useful byte +1}
  788.   begin
  789.   with P^ do
  790.     begin
  791.     if FindLabel(PCsave) then
  792.       begin    {put it into textarray}
  793.       LB:=FormLabel(PCsave)+':';  {in string form}
  794.       Move(LB[1], S[1], Ord(LB[0]));
  795.       end
  796.     else PCsave:=$2020;      {replace integer by 2 spaces}
  797.     WriteLn(Outf,S);
  798.     Tmp:=Len+1;
  799.     end;
  800.   I:=I+Tmp;
  801.   Px.R:=Px.R+Tmp;
  802.   end;
  803. end;
  804.  
  805. {-------------MAIN}
  806. begin
  807. WriteLn(Signon1,Signon2);
  808. ErrCount:=0;
  809. PC:=0;  BytePending:=False;  Firsttime:=True;
  810. if ParamCount >= 1 then CommandInput else PromptForInput;
  811. EofInf:=False;
  812. St[0]:=#0;  Chi:=1;  {get the reading started}
  813. GetCh;
  814. GetToken;
  815. while not EofInf do
  816.   if Token='INLINE' then
  817.     begin
  818.     TIndex:=0;   {index into TextArray}
  819.     PCstart:=PC; LabelIndx:=0;
  820.     if not Firsttime then
  821.       WriteLn(Outf,'NEW');
  822.     Next;
  823.     if Sy=Lparn then Next;
  824.     while (Sy<>Rparn) and not EofInf do UnAssem1;
  825.     if Sy=Rparn then GetToken;
  826.     Firsttime:=False;
  827.     PCfinish:=PC;
  828.     Ustring.S:='        ';  {Provide for possible label at the end}
  829.     Ustring.PCsave:=PC;
  830.     OutUstring;
  831.     WriteToFile;   {TextArray to outf, adding labels as req'd}
  832.     ReportLabelErrors;
  833.     end
  834.   else GetToken;
  835. Close(Inf);
  836. Close(Outf);
  837. end.
  838.